home *** CD-ROM | disk | FTP | other *** search
/ Chip: Internet / Chip Internet.iso / viewer / gsnt / source / interp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-05-20  |  26.4 KB  |  889 lines
  1. /* Copyright (C) 1989, 1992, 1993 Aladdin Enterprises.  All rights reserved.
  2.  
  3. This file is part of Ghostscript.
  4.  
  5. Ghostscript is distributed in the hope that it will be useful, but
  6. WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  7. to anyone for the consequences of using it or for whether it serves any
  8. particular purpose or works at all, unless he says so in writing.  Refer
  9. to the Ghostscript General Public License for full details.
  10.  
  11. Everyone is granted permission to copy, modify and redistribute
  12. Ghostscript, but only under the conditions described in the Ghostscript
  13. General Public License.  A copy of this license is supposed to have been
  14. given to you along with Ghostscript so you can know your rights and
  15. responsibilities.  It should be in a file named COPYING.  Among other
  16. things, the copyright notice and this notice must be preserved on all
  17. copies.  */
  18.  
  19. /* interp.c */
  20. /* Ghostscript language interpreter */
  21. #include "memory_.h"
  22. #include "ghost.h"
  23. #include "stream.h"
  24. #include "errors.h"
  25. #include "estack.h"
  26. #include "iname.h"
  27. #include "iscan.h"
  28. #include "dict.h"
  29. #include "dstack.h"
  30. #include "oper.h"
  31. #include "packed.h"
  32. #include "save.h"
  33. #include "store.h"
  34.  
  35. /* Imported operator procedures */
  36. extern int obj_le(P2(os_ptr, os_ptr));
  37. extern int zop_add(P1(os_ptr));
  38. extern int zop_def(P1(os_ptr));
  39. extern int zop_sub(P1(os_ptr));
  40. /* Other imported procedures */
  41. extern int in_stopped(P0());
  42.  
  43. /* 
  44.  * The procedure to call if an operator requests rescheduling.
  45.  * This causes an error unless the context machinery has been installed.
  46.  */
  47. private int
  48. no_reschedule(void)
  49. {    return_error(e_invalidcontext);
  50. }
  51. int (*gs_interp_reschedule_proc)(P0()) = no_reschedule;
  52. /*
  53.  * The procedure to call for time-slicing.
  54.  * This is a no-op unless the context machinery has been installed.
  55.  */
  56. private int
  57. no_time_slice(void)
  58. {    return 0;
  59. }
  60. int (*gs_interp_time_slice_proc)(P0()) = no_time_slice;
  61.  
  62. /* Forward references */
  63. private int interp(P2(ref *pref, ref *perror_object));
  64. private int interp_exit(P1(os_ptr));
  65. private int copy_stack(P3(const ref *, uint, ref *));
  66.  
  67. /* Configuration parameters */
  68. #define max_ostack 800
  69. #define max_estack 150
  70. #define max_dstack 20
  71. uint min_dstack_size;        /* set by iinit.c */
  72. ref ref_language_level;        /* 1 or 2, set by iinit.c */
  73.  
  74. /* See estack.h for a description of the execution stack. */
  75.  
  76. /* The logic for managing icount and iref below assumes that */
  77. /* there are no control operators which pop and then push */
  78. /* information on the execution stack. */
  79.  
  80. /* Stacks */
  81. #define os_guard_under 10
  82. #define os_guard_over 10
  83. private ref ostack[os_guard_under+max_ostack+os_guard_over];
  84. private ref estack[max_estack];
  85. private ref dstack[max_dstack];
  86. os_ptr osp_nargs[os_max_nargs];        /* for checking osp */
  87.  
  88. /* Stack pointers */
  89. os_ptr osbot, osp, ostop;
  90. es_ptr esbot, esp, estop;
  91. es_ptr esfile;                /* cache pointer to currentfile */
  92. ds_ptr dsbot, dsp, dstop;
  93.  
  94. /* Object related to error handling */
  95. extern ref name_errordict;
  96. extern ref name_ErrorNames;
  97.  
  98. /* Extended types.  The interpreter may replace the type of operators */
  99. /* in procedures with these, to speed up the interpretation loop. */
  100. #define tx_op t_next_index
  101. extern int zadd(P1(os_ptr));
  102. extern int zdef(P1(os_ptr));
  103. extern int zdup(P1(os_ptr));
  104. extern int zexch(P1(os_ptr));
  105. extern int zif(P1(os_ptr));
  106. extern int zifelse(P1(os_ptr));
  107. extern int zindex(P1(os_ptr));
  108. extern int zle(P1(os_ptr));
  109. extern int zpop(P1(os_ptr));
  110. extern int zroll(P1(os_ptr));
  111. extern int zsub(P1(os_ptr));
  112. private const op_proc_p special_ops[] = {
  113.     zadd, zdef, zdup, zexch, zif, zifelse, zindex, zle, zpop, zroll, zsub
  114. };
  115. typedef enum {
  116.     tx_op_add = tx_op,
  117.     tx_op_def,
  118.     tx_op_dup,
  119.     tx_op_exch,
  120.     tx_op_if,
  121.     tx_op_ifelse,
  122.     tx_op_index,
  123.     tx_op_le,
  124.     tx_op_pop,
  125.     tx_op_roll,
  126.     tx_op_sub,
  127.     tx_next_op
  128. } special_op_types;
  129. #define num_special_ops ((int)tx_next_op - tx_op)
  130. #define t_invalid tx_next_op        /* first invalid type */
  131. const int tx_next_index = tx_next_op;
  132.  
  133. /* Initialize the interpreter */
  134. void
  135. gs_interp_reset(void)
  136. {    /* Just reset the stacks. */
  137.     osp = osbot - 1;
  138.     esp = estack - 1;
  139.     dsp = dstack + (min_dstack_size - 1);
  140. }
  141. void
  142. interp_init(void)
  143. {    /* Initialize the guard entries on the operand stack */
  144.     /* with objects that have invalid type and attributes. */
  145.     osbot = ostack + os_guard_under;
  146.     ostop = osbot + (max_ostack-1);
  147.        {    register os_ptr op;
  148.         for ( op = ostack; op < osbot; op++ )
  149.             make_tav(op, t_invalid, 0, index, 0);
  150.        }
  151.        {    register int i;
  152.         for ( i = 1; i <= os_max_nargs; i++ )
  153.             op_nargs_check(i) = osbot + i - 1;
  154.        }
  155.     /* Initialize the other stacks. */
  156.     esbot = estack;
  157.     estop = estack + (max_estack-1);
  158.     esfile = 0;
  159.     dsbot = dstack;
  160.     dstop = dstack + (max_dstack-1);
  161.     /* Reset the stack pointers. */
  162.     gs_interp_reset();
  163. }
  164.  
  165. /* Look up an operator during initialization, */
  166. /* changing its type if appropriate. */
  167. void
  168. interp_fix_op(ref *opref)
  169. {    register int i = num_special_ops;
  170.     op_proc_p proc = real_opproc(opref);
  171.     while ( --i >= 0 && proc != special_ops[i] ) ;
  172.     if ( i >= 0 )
  173.       make_tasv(opref, tx_op + i, a_executable, r_size(opref), opproc,
  174.            (dummy_op_proc_p)proc);
  175. }
  176.  
  177. /*
  178.  * Invoke the interpreter.  If execution completes normally, return 0.
  179.  * If an error occurs, the action depends on user_errors as follows:
  180.  *    user_errors < 0: always return an error code.
  181.  *    user_errors == 0: let the normal PostScript error handling
  182.  *        machinery handle it if a `stopped' is active,
  183.  *        otherwise return the error code.
  184.  *    user_errors > 0: let the PostScript machinery handle all errors.
  185.  * In case of a quit or a fatal error, also store the exit code.
  186.  */
  187. int
  188. gs_interpret(ref *pref, int user_errors, int *pexit_code, ref *perror_object)
  189. {    ref *epref = pref;
  190.     ref erref;
  191.     ref *perrordict, *pErrorNames;
  192.     int code, ccode;
  193.     ref saref;
  194.     /* Push a special exit procedure on the execution stack */
  195.     es_ptr esp0 = ++esp;
  196.     make_oper(esp0, 0, (dummy_op_proc_p)interp_exit);
  197.     *pexit_code = 0;
  198. retry:    code = interp(epref, perror_object);
  199.     switch ( code )
  200.     {
  201.     case e_Fatal:
  202.         *pexit_code = 255;
  203.         return code;
  204.     case e_Quit:
  205.         if ( (*pexit_code = (int)osp->value.intval) != 0 )
  206.             code = e_Fatal;
  207.         return code;
  208.     case e_InterpreterExit:
  209.         return 0;
  210.     }
  211.     /* Adjust osp in case of operand stack underflow */
  212.     if ( osp < osbot - 1 )
  213.         osp = osbot - 1;
  214.     if ( user_errors < 0 || (user_errors == 0 && !in_stopped()) )
  215.         return code;
  216.     if ( dict_find(systemdict, &name_errordict, &perrordict) <= 0 ||
  217.          dict_find(systemdict, &name_ErrorNames, &pErrorNames) <= 0
  218.        )
  219.         return code;    /* errordict or ErrorNames not found?? */
  220.     switch ( code )
  221.        {
  222.     case e_dictstackoverflow:
  223.         if ( osp + 1 >= ostop )
  224.             return_error(e_stackoverflow);
  225.         ccode = copy_stack(dsbot, dsp - dsbot + 1, &saref);
  226.         if ( ccode < 0 ) return ccode;
  227.         dsp = dsbot + (min_dstack_size - 1);
  228.         *++osp = saref;
  229.         break;
  230.     case e_execstackoverflow:
  231.         if ( osp + 1 >= ostop )
  232.             return_error(e_stackoverflow);
  233.         ccode = copy_stack(estack, esp - estack + 1, &saref);
  234.         if ( ccode < 0 ) return ccode;
  235.         esp = esp0;
  236.         *++osp = saref;
  237.         break;
  238.     case e_stackoverflow:
  239.         ccode = copy_stack(ostack, osp - osbot + 1, &saref);
  240.         if ( ccode < 0 ) return ccode;
  241.         osp = osbot;
  242.         *osbot = saref;
  243.         break;
  244.        }
  245.     if ( -code > r_size(pErrorNames) )
  246.         return code;        /* unknown error??? */
  247.     if ( dict_find(perrordict, &pErrorNames->value.refs[-code - 1], &epref) <= 0 )
  248.         return code;        /* error name not in errordict??? */
  249.     erref = *epref;
  250.     epref = &erref;
  251.     /* Push the error object on the operand stack */
  252.     *++osp = *perror_object;
  253.     goto retry;
  254. }    
  255. private int
  256. interp_exit(os_ptr op)
  257. {    return e_InterpreterExit;
  258. }
  259.  
  260. /* Copy the contents of an overflowed stack into an array. */
  261. private int
  262. copy_stack(const ref *stk, uint size, ref *arr)
  263. {    int code = alloc_array(arr, a_all, size, "overflowed stack");
  264.     if ( code < 0 ) return code;
  265.     refcpy_to_new(arr->value.refs, stk, size);
  266.     return 0;
  267. }
  268.  
  269. /* Main interpreter. */
  270. /* If execution terminates normally, return e_InterpreterExit. */
  271. /* If an error occurs, leave the current object in *perror_object */
  272. /* and return a (negative) error code. */
  273. private int
  274. interp(ref *pref /* object to interpret */, ref *perror_object)
  275. {    register ref *iref = pref;
  276.     register int icount = 0;    /* # of consecutive tokens at iref */
  277.     register os_ptr iosp = osp;    /* private copy of osp */
  278.     register es_ptr iesp = esp;    /* private copy of esp */
  279.     int code;
  280.     ref token;        /* token read from file or string, */
  281.                 /* must be declared in this scope */
  282.     register ref *pvalue;
  283.     os_ptr whichp;
  284.     /* We have to make the error information into a struct; */
  285.     /* otherwise, the Watcom compiler will assign it to registers */
  286.     /* strictly on the basis of textual frequency. */
  287.     /* We also have to use ref_assign_inline everywhere, and */
  288.     /* avoid direct assignments of refs, so that esi and edi */
  289.     /* will remain available on Intel processors. */
  290.     struct interp_error_s {
  291.         int code;
  292.         int line;
  293.         ref *obj;
  294.     } ierror;
  295. #define return_with_error(ecode, objp)\
  296.   { ierror.code = ecode; ierror.obj = objp;\
  297.     ierror.line = __LINE__; goto rwe;\
  298.   }
  299. #define return_with_error_code_iref()\
  300.   { ierror.line = __LINE__; goto rweci;\
  301.   }
  302. #define return_with_error_short(ecode, objp)\
  303.   { ierror.code = ecode; ierror.obj = objp;\
  304.     ierror.line = __LINE__; goto rwe_short;\
  305.   }
  306.     esfile = 0;        /* clear cache */
  307.     /* From here on, if icount > 0, iref and icount correspond */
  308.     /* to the top entry on the execution stack: icount is the */
  309.     /* count of sequential entries remaining AFTER the current one. */
  310. #define add1_short(pref) (ref *)((ushort *)(pref) + 1)
  311. #define store_state(ep)\
  312.   ( icount > 0 ? (ep->value.refs = iref + 1, r_set_size(ep, icount)) : 0 )
  313. #define store_state_short(ep)\
  314.   ( icount > 0 ? (ep->value.refs = add1_short(iref), r_set_size(ep, icount)) : 0 )
  315. #define next()\
  316.   if ( --icount > 0 ) { iref++; goto top; } else goto out
  317. #define next_short()\
  318.   if ( --icount <= 0 ) { if ( icount < 0 ) goto up; iesp--; }\
  319.   iref = add1_short(iref); goto top;
  320.     /* We want to recognize executable arrays here, */
  321.     /* so we push the argument on the estack and enter */
  322.     /* the loop at the bottom. */
  323.     if ( iesp >= estop ) return_with_error (e_execstackoverflow, pref);
  324.     ++iesp;
  325.     ref_assign_inline(iesp, pref);
  326.     goto bot;
  327. top:    /*
  328.      * This is the top of the interpreter loop.
  329.      * iref points to the ref being interpreted.
  330.      * Note that this might be an element of a packed array,
  331.      * not a real ref: we carefully arranged the first 16 bits of
  332.      * a ref and of a packed array element so they could be distinguished
  333.      * from each other.  (See ghost.h and packed.h for more detail.)
  334.      */
  335. #ifdef DEBUG
  336. if ( gs_debug['I'] || gs_debug['i'] &&
  337.      (*(ushort *)iref <= packed_max_full_ref ? r_type(iref) == t_name :
  338.       *(short *)iref < 0)
  339.    )
  340.    {    void debug_print_ref(P1(ref *));
  341.     int edepth = iesp - esbot;
  342.     char depth[10];
  343.     sprintf(depth, "%2d", edepth);
  344.     dputs(depth);
  345.     edepth -= strlen(depth);
  346.     do { dputc('.'); } while ( --edepth > 0 );    /* indent */
  347.     dprintf3("%lx(%2d)<%2d>: ",
  348.          (ulong)iref, icount, (uint)(iosp - osbot + 1));
  349.     debug_print_ref(iref);
  350.     if ( iosp >= osbot )
  351.        {    dputs(" // ");
  352.         debug_print_ref(iosp);
  353.        }
  354.     dputc('\n');
  355.     fflush(dstderr);
  356.    }
  357. #endif
  358. /* Object that have attributes (arrays, dictionaries, files, and strings) */
  359. /* use lit and exec; other objects use plain and plain_exec. */
  360. #define lit(t) type_xe_value(t, a_execute)
  361. #define exec(t) type_xe_value(t, a_execute + a_executable)
  362. #define nox(t) type_xe_value(t, 0)
  363. #define nox_exec(t) type_xe_value(t, a_executable)
  364. #define plain(t) type_xe_value(t, 0)
  365. #define plain_exec(t) type_xe_value(t, a_executable)
  366.     /*
  367.      * We have to populate enough cases of the switch statement to force
  368.      * some compilers to use a dispatch rather than a testing loop.
  369.      * What a nuisance!
  370.      */
  371.     switch ( r_type_xe(iref) )
  372.        {
  373.     /* Access errors. */
  374. #define cases_nox()\
  375.   case nox_exec(t_array): case nox_exec(t_dictionary):\
  376.   case nox_exec(t_file): case nox_exec(t_string):\
  377.   case nox_exec(t_mixedarray): case nox_exec(t_shortarray)
  378.     cases_nox():
  379.         return_with_error (e_invalidaccess, iref);
  380.     /*
  381.      * Literal objects.  We have to enumerate all the types.
  382.      * In fact, we have to include some extra plain_exec entries
  383.      * just to populate the switch.  We break them up into groups
  384.      * to avoid overflowing some preprocessors.
  385.      */
  386. #define cases_lit_1()\
  387.   case lit(t_array): case nox(t_array):\
  388.   case plain(t_boolean): case plain_exec(t_boolean):\
  389.   case plain(t_condition): case plain_exec(t_condition):\
  390.   case lit(t_dictionary): case nox(t_dictionary)
  391. #define cases_lit_2()\
  392.   case lit(t_file): case nox(t_file):\
  393.   case plain(t_fontID): case plain_exec(t_fontID):\
  394.   case plain(t_gstate): case plain_exec(t_gstate):\
  395.   case plain(t_integer): case plain_exec(t_integer)
  396. #define cases_lit_3()\
  397.   case plain(t_lock): case plain_exec(t_lock):\
  398.   case plain(t_mark): case plain_exec(t_mark):\
  399.   case plain(t_name):\
  400.   case plain(t_null):\
  401.   case plain(t_oparray):\
  402.   case plain(t_operator)
  403. #define cases_lit_4()\
  404.   case plain(t_real): case plain_exec(t_real):\
  405.   case plain(t_save): case plain_exec(t_save):\
  406.   case lit(t_string): case nox(t_string)
  407. #define cases_lit_5()\
  408.   case lit(t_mixedarray): case nox(t_mixedarray):\
  409.   case lit(t_shortarray): case nox(t_shortarray):\
  410.   case plain(t_device): case plain_exec(t_device)
  411.     /* Executable arrays are treated as literals in direct execution. */
  412. #define cases_lit_array()\
  413.   case exec(t_array): case exec(t_mixedarray): case exec(t_shortarray)
  414.     cases_lit_1():
  415.     cases_lit_2():
  416.     cases_lit_3():
  417.     cases_lit_4():
  418.     cases_lit_5():
  419.     cases_lit_array():
  420.         break;
  421.     /* Special operators. */
  422.     case plain_exec(tx_op_add):
  423. x_add:        if ( (code = zop_add(iosp)) < 0 )
  424.             return_with_error_code_iref();
  425.         iosp--;
  426.         next();
  427.     case plain_exec(tx_op_def):
  428. x_def:        if ( (code = zop_def(iosp)) < 0 )
  429.             return_with_error_code_iref();
  430.         iosp -= 2;
  431.         next();
  432.     case plain_exec(tx_op_dup):
  433. x_dup:        if ( iosp < op_nargs_check(1) )
  434.             return_with_error (e_stackunderflow, iref);
  435.         iosp++;
  436.         ref_assign_inline(iosp, iosp - 1);
  437.         next();
  438.     case plain_exec(tx_op_exch):
  439. x_exch:        if ( iosp < op_nargs_check(2) )
  440.             return_with_error (e_stackunderflow, iref);
  441.         ref_assign_inline(&token, iosp);
  442.         ref_assign_inline(iosp, iosp - 1);
  443.         ref_assign_inline(iosp - 1, &token);
  444.         next();
  445.     case plain_exec(tx_op_if):
  446. x_if:        if ( !r_has_type(iosp - 1, t_boolean) )
  447.           return_with_error (e_typecheck, iref);
  448.         if ( !iosp[-1].value.index )
  449.           { iosp -= 2;
  450.             next();
  451.           }
  452.         if ( iesp >= estop )
  453.           return_with_error (e_execstackoverflow, iref);
  454.         store_state(iesp);
  455.         whichp = iosp;
  456.         iosp -= 2;
  457.         goto ifup;
  458.     case plain_exec(tx_op_ifelse):
  459. x_ifelse:    if ( !r_has_type(iosp - 2, t_boolean) )
  460.             return_with_error (e_typecheck, iref);
  461.         if ( iesp >= estop )
  462.             return_with_error (e_execstackoverflow, iref);
  463.         store_state(iesp);
  464.         whichp = (iosp[-2].value.index ? iosp - 1 : iosp);
  465.         iosp -= 3;
  466.         /* Open code "up" for the array case(s) */
  467. ifup:        if ( !r_is_proc(whichp) )
  468.            {    /* This is an unusual enough case that we go ahead */
  469.             /* and clear the currentfile cache without */
  470.             /* checking whether we have an exec(t_file), */
  471.             /* just to avoid another case test. */
  472.             esfile = 0;
  473.             ref_assign_inline(iesp + 1, whichp);
  474.             iref = iesp + 1;
  475.             icount = 0;
  476.             goto top;
  477.            }
  478.         if ( (icount = r_size(whichp) - 1) <= 0 )
  479.            {    if ( icount < 0 ) goto up;    /* 0-element proc */
  480.             iref = whichp->value.refs;    /* 1-element proc */
  481.             goto top;
  482.            }
  483.         ++iesp;
  484.         /* Do a ref_assign, but also set iref. */
  485.         iesp->tas = whichp->tas;
  486.         iref = iesp->value.refs = whichp->value.refs;
  487.         goto top;
  488.     case plain_exec(tx_op_index):
  489. x_index:    if ( (code = zindex(iosp)) < 0 )
  490.             return_with_error_code_iref();
  491.         next();
  492.     case plain_exec(tx_op_le):
  493. x_le:        code = obj_le(iosp - 1, iosp);
  494.         if ( code < 0 )
  495.             return_with_error_code_iref();
  496.         iosp--;
  497.         make_bool(iosp, code);
  498.         next();
  499.     case plain_exec(tx_op_pop):
  500. x_pop:        if ( iosp < op_nargs_check(1) )
  501.             return_with_error (e_stackunderflow, iref);
  502.         iosp--;
  503.         next();
  504.     case plain_exec(tx_op_roll):
  505. x_roll:        if ( (code = zroll(iosp)) < 0 )
  506.             return_with_error_code_iref();
  507.         iosp -= 2;
  508.         next();
  509.     case plain_exec(tx_op_sub):
  510. x_sub:        if ( (code = zop_sub(iosp)) < 0 )
  511.             return_with_error_code_iref();
  512.         iosp--;
  513.         next();
  514.     /* Executable types. */
  515.     case plain_exec(t_null):
  516.         goto bot;
  517.     case plain_exec(t_oparray):
  518.         /* Replace with the definition and go again. */
  519.         pvalue =
  520.           &op_array_table.value.refs[op_index(iref) - op_def_count];
  521. prst:        /* Prepare to call the procedure (array) in *pvalue. */
  522.         store_state(iesp);
  523. pr:        /* Call the array in *pvalue.  State has been stored. */
  524.         if ( (icount = r_size(pvalue) - 1) <= 0 )
  525.            {    if ( icount < 0 ) goto up;    /* 0-element proc */
  526.             iref = pvalue->value.refs;    /* 1-element proc */
  527.             goto top;
  528.            }
  529.         if ( iesp >= estop )
  530.             return_with_error (e_execstackoverflow, pvalue);
  531.         ++iesp;
  532.         /* Do a ref_assign, but also set iref. */
  533.         iesp->tas = pvalue->tas;
  534.         iref = iesp->value.refs = pvalue->value.refs;
  535.         goto top;
  536.     case plain_exec(t_operator):
  537.        {    esp = iesp;        /* save for operator */
  538.         osp = iosp;        /* ditto */
  539.         /* Operator routines take osp as an argument. */
  540.         /* This is just a convenience, since they adjust */
  541.         /* osp themselves to reflect the results. */
  542.         /* Operators that (net) push information on the */
  543.         /* operand stack must check for overflow: */
  544.         /* this normally happens automatically through */
  545.         /* the push macro (in oper.h). */
  546.         /* Operators that do not typecheck their operands, */
  547.         /* or take a variable number of arguments, */
  548.         /* must check explicitly for stack underflow. */
  549.         /* (See oper.h for more detail.) */
  550.         /* Note that each case must set iosp = osp: */
  551.         /* this is so we can switch on code without having to */
  552.         /* store it and reload it (for dumb compilers). */
  553.         switch ( code = (*real_opproc(iref))(iosp) )
  554.            {
  555.         case 0:            /* normal case */
  556.             iosp = osp;
  557.             next();
  558.         case o_push_estack:    /* store the state and go to up */
  559.             iosp = osp;
  560.             store_state(iesp);
  561.             iesp = esp;
  562.             goto up;
  563.         case o_pop_estack:    /* just go to up */
  564.             iosp = osp;
  565.             if ( esp == iesp ) goto bot;
  566.             iesp = esp;
  567.             goto up;
  568.         case o_reschedule:
  569.             store_state(iesp);
  570.             goto res;
  571.         case e_typecheck:
  572.             /* This might be an operand stack */
  573.             /* underflow: check the required # of */
  574.             /* operands now. */
  575.             if ( osp < osbot - 1 + op_num_args(iref) )
  576.                 code = e_stackunderflow;
  577.             /* (falls through) */
  578.            }
  579.         iosp = osp;
  580.         return_with_error_code_iref();
  581.        }
  582.     case plain_exec(t_name):
  583.         pvalue = iref->value.pname->pvalue;
  584.         if ( !pv_valid(pvalue) )
  585.            {    ref *pdvalue;
  586.             if ( (pdvalue = dict_find_name(iref)) == 0 )
  587.                 return_with_error (e_undefined, iref);
  588.             pvalue = pdvalue;
  589.            }
  590.         /* Dispatch on the type of the value. */
  591.         /* Again, we have to over-populate the switch. */
  592.         switch ( r_type_xe(pvalue) )
  593.            {
  594.         cases_nox():    /* access errors */
  595.             return_with_error (e_invalidaccess, iref);
  596.         cases_lit_1():
  597.         cases_lit_2():
  598.         cases_lit_3():
  599.         cases_lit_4():
  600.         cases_lit_5():
  601.             /* Just push the value */
  602.             if ( iosp >= ostop )
  603.                 return_with_error (e_stackoverflow, pvalue);
  604.             ++iosp;
  605.             ref_assign_inline(iosp, pvalue);
  606.             next();
  607.         case exec(t_array):
  608.         case exec(t_mixedarray):
  609.         case exec(t_shortarray):
  610.             /* This is an executable procedure, execute it. */
  611.             goto prst;
  612.         case plain_exec(tx_op_add): goto x_add;
  613.         case plain_exec(tx_op_def): goto x_def;
  614.         case plain_exec(tx_op_dup): goto x_dup;
  615.         case plain_exec(tx_op_exch): goto x_exch;
  616.         case plain_exec(tx_op_if): goto x_if;
  617.         case plain_exec(tx_op_ifelse): goto x_ifelse;
  618.         case plain_exec(tx_op_index): goto x_index;
  619.         case plain_exec(tx_op_le): goto x_le;
  620.         case plain_exec(tx_op_pop): goto x_pop;
  621.         case plain_exec(tx_op_roll): goto x_roll;
  622.         case plain_exec(tx_op_sub): goto x_sub;
  623.         case plain_exec(t_null):
  624.             goto bot;
  625.         case plain_exec(t_oparray):
  626.             pvalue =
  627.               &op_array_table.value.refs[op_index(pvalue) -
  628.                              op_def_count];
  629.             goto prst;
  630.         case plain_exec(t_operator):
  631.            {    /* Shortcut for operators. */
  632.             /* See above for the logic. */
  633.             esp = iesp;
  634.             osp = iosp;
  635.             switch ( code = (*real_opproc(pvalue))(iosp) )
  636.                {
  637.             case 0:            /* normal case */
  638.                 iosp = osp;
  639.                 next();
  640.             case o_push_estack:    /* store the state and go to up */
  641.                 iosp = osp;
  642.                 store_state(iesp);
  643.                 iesp = esp;
  644.                 goto up;
  645.             case o_pop_estack:    /* just go to up */
  646.                 iosp = osp;
  647.                 if ( esp == iesp ) goto bot;
  648.                 iesp = esp;
  649.                 goto up;
  650.             case o_reschedule:
  651.                 store_state(iesp);
  652.                 goto res;
  653.             case e_typecheck:
  654.                 if ( osp < osbot - 1 + op_num_args(pvalue) )
  655.                     code = e_stackunderflow;
  656.                }
  657.             iosp = osp;
  658.             return_with_error (code, pvalue);
  659.            }
  660.         case plain_exec(t_name):
  661.         case exec(t_file):
  662.         case exec(t_string):
  663.         default:
  664.             /* Not a procedure, reinterpret it. */
  665.             store_state(iesp);
  666.             icount = 0;
  667.             iref = pvalue;
  668.             goto top;
  669.            }
  670.     case exec(t_file):
  671.        {    /* Executable file.  Read the next token and interpret it. */
  672.            stream *s;
  673.         code = file_check_read(iref, &s);
  674.         if ( code < 0 ) return_with_error_code_iref();
  675. rt:        if ( iosp >= ostop )    /* check early */
  676.           return_with_error (e_stackoverflow, iref);
  677.         osp = iosp;        /* scan_token uses ostack */
  678.         switch ( code = scan_token(s, 0, (ref *)(iosp + 1)) )
  679.            {
  680.         case 0:            /* read a token */
  681.             /* It's worth checking for literals, which make up */
  682.             /* the majority of input tokens, before storing the */
  683.             /* state on the e-stack.  Note that because of //, */
  684.             /* the token may have *any* type and attributes. */
  685.             /* Note also that executable arrays aren't executed */
  686.             /* at the top level -- they're treated as literals. */
  687.             if ( !r_has_attr(iosp + 1, a_executable) ||
  688.                  r_is_array(iosp + 1)
  689.                )
  690.             {    iosp++;
  691.                 goto rt;
  692.             }
  693.             store_state(iesp);
  694.             /* Push the file on the e-stack */
  695.             if ( iesp >= estop )
  696.                 return_with_error (e_execstackoverflow, iref);
  697.             ++iesp;
  698.             ref_assign_inline(iesp, iref);
  699.             iref = iosp + 1;
  700.             icount = 0;
  701.             goto top;
  702.         case scan_EOF:        /* end of file */
  703.             code = file_close(iref);
  704.             if ( code < 0 )
  705.                 return_with_error_code_iref();
  706.             goto bot;
  707.         case scan_BOS:
  708.             /* Binary object sequences */
  709.             /* ARE executed at the top level. */
  710.             store_state(iesp);
  711.             /* Push the file on the e-stack */
  712.             if ( iesp >= estop )
  713.                 return_with_error (e_execstackoverflow, iref);
  714.             ++iesp;
  715.             ref_assign_inline(iesp, iref);
  716.             pvalue = iosp + 1;
  717.             goto pr;
  718.         default:        /* error */
  719.             return_with_error_code_iref();
  720.            }
  721.        }
  722.     case exec(t_string):
  723.        {    /* Executable string.  Read a token and interpret it. */
  724.         stream ss;
  725.         sread_string(&ss, iref->value.bytes, r_size(iref));
  726.         osp = iosp;        /* scan_token uses ostack */
  727.         switch ( code = scan_token(&ss, 1, &token) )
  728.           {
  729.         case 0:            /* read a token */
  730.         case scan_BOS:        /* binary object sequence */
  731.             store_state(iesp);
  732.             /* Push the updated string back on the e-stack */
  733.             if ( iesp >= estop )
  734.               return_with_error (e_execstackoverflow, iref);
  735.             ++iesp;
  736.             iesp->tas.type_attrs = iref->tas.type_attrs;
  737.             iesp->value.bytes = ss.cptr + 1;
  738.             r_set_size(iesp, ss.cbuf + ss.bsize - ss.cptr - 1);
  739.             if ( code == 0 )
  740.             {    iref = &token;
  741.             icount = 0;
  742.             goto top;
  743.             }
  744.             /* Handle BOS specially */
  745.             pvalue = &token;
  746.             goto pr;
  747.         case scan_EOF:        /* end of string */
  748.             goto bot;
  749.         default:        /* error */
  750.             return_with_error_code_iref();
  751.           }
  752.        }
  753.     /* Handle packed arrays here by re-dispatching. */
  754.     /* This also picks up some anomalous cases of non-packed arrays. */
  755.     default:
  756.         switch ( *(ushort *)iref >> packed_type_shift )
  757.            {
  758.         case pt_full_ref:
  759.         case pt_full_ref+1:
  760.             if ( iosp >= ostop )
  761.               return_with_error(e_stackoverflow, iref);
  762.             ++iosp;
  763.             /* We know that refs are properly aligned: */
  764.             /* see packed.h for details. */
  765.             ref_assign_inline(iosp, iref);
  766.             next();
  767.         case pt_executable_operator:
  768.            {    uint index = *(ushort *)iref & packed_int_mask;
  769.             op_index_ref(index, &token);
  770.             store_state_short(iesp);
  771.             icount = 0;
  772.             iref = &token;
  773.            }    goto top;
  774.         case pt_integer:
  775.             if ( iosp >= ostop )
  776.               return_with_error_short(e_stackoverflow, iref);
  777.             ++iosp;
  778.             make_int(iosp, (*(short *)iref & packed_int_mask) +
  779.                     packed_min_intval);
  780.             next_short();
  781.         case pt_literal_name:
  782.         case pt_literal_name+1:
  783.             if ( iosp >= ostop )
  784.               return_with_error_short(e_stackoverflow, iref);
  785.             ++iosp;
  786.             name_index_ref((uint)*(ushort *)iref &
  787.                          packed_max_name_index,
  788.                        iosp);
  789.             next_short();
  790.         case pt_executable_name:
  791.         case pt_executable_name+1:
  792.            {    ref nref;
  793.             uint nidx = *(ushort *)iref & packed_max_name_index;
  794.             name_index_ref(nidx, &nref);
  795.             pvalue = nref.value.pname->pvalue;
  796.             if ( !pv_valid(pvalue) )
  797.                {    ref *pdvalue;
  798.                 if ( (pdvalue = dict_find_name_by_index(nidx)) == 0 )
  799.                   return_with_error_short(e_undefined, &nref);
  800.                 pvalue = pdvalue;
  801.                }
  802.             if ( r_is_proc(pvalue) )
  803.                {    /* This is an executable procedure, */
  804.                 /* execute it. */
  805.                 store_state_short(iesp);
  806.                 goto pr;
  807.                }
  808.             /* Not a procedure, reinterpret it. */
  809.             store_state_short(iesp);
  810.             icount = 0;
  811.             iref = pvalue;
  812.             goto top;
  813.            }
  814.         /* default can't happen here */
  815.            }
  816.        }
  817.     /* Literal type, just push it. */
  818.     if ( iosp >= ostop ) return_with_error (e_stackoverflow, iref);
  819.     ++iosp;
  820.     ref_assign_inline(iosp, iref);
  821. bot:    next();
  822. out:    /* At most 1 more token in the current procedure. */
  823.     /* (We already decremented icount.) */
  824.     if ( !icount )
  825.        {    /* Pop the execution stack for tail recursion. */
  826.         iesp--;
  827.         iref++;
  828.         goto top;
  829.        }
  830. up:    /* See if there is anything left on the execution stack. */
  831.     if ( !r_is_proc(iesp) )
  832.        {    iref = iesp--;
  833.         icount = 0;
  834.         goto top;
  835.        }
  836.     iref = iesp->value.refs;        /* next element of array */
  837.     icount = r_size(iesp) - 1;
  838.     if ( icount <= 0 )        /* <= 1 more elements */
  839.        {    iesp--;            /* pop, or tail recursion */
  840.         if ( icount < 0 ) goto up;
  841.        }
  842.     goto top;
  843. res:    /* Some operator has asked for context rescheduling. */
  844.     code = (*gs_interp_reschedule_proc)();
  845.     if ( code < 0 ) return_with_error_code_iref();
  846.     /* Reload state information from memory. */
  847.     iosp = osp;
  848.     iesp = esp;
  849.     goto up;
  850.  
  851.     /* Error exits. */
  852.  
  853. rweci:
  854.     ierror.code = code;
  855.     ierror.obj = iref;
  856. rwe:
  857.     store_state(iesp);
  858.     goto error_exit;
  859. rwe_short:
  860.     store_state_short(iesp);
  861. error_exit:
  862.     if ( ierror.code == e_interrupt )
  863.     {    /* We must push the current object being interpreted */
  864.         /* back on the e-stack so it will be re-executed. */
  865.         /* Currently, this is always an executable operator, */
  866.         /* but it might be something else someday if we check */
  867.         /* for interrupts in the interpreter loop itself. */
  868.         if ( iesp >= estop )
  869.             code = e_execstackoverflow;
  870.         else
  871.         {    iesp++;
  872.             ref_assign_inline(iesp, iref);
  873.         }
  874.     }
  875.     esp = iesp;
  876.     osp = iosp;
  877.     ref_assign_inline(perror_object, ierror.obj);
  878.     return gs_log_error(ierror.code, __FILE__, ierror.line);
  879.  
  880. }
  881.  
  882. /* ------ Initialization procedure ------ */
  883.  
  884. op_def interp_op_defs[] = {
  885.         /* Internal operators */
  886.     {"0%interp_exit", interp_exit},
  887.     op_def_end(0)
  888. };
  889.